perm filename PUB2.SAI[XGP,TES] blob
sn#027190 filedate 1973-02-22 generic text, type T, neo UTF8
00100 BEGIN "PUB2"
00200 DEFINE CMU="COMMENT", SIMPLE="";
00300 REQUIRE 6500 STRING_SPACE ;
00400 COMMENT The Document Compiler -- Pass Two ;
00500 COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
00600 Height Width
00700 For each area:
00800 UpperLine NumCols NumLines
00900 For each column:
01000 LeftChar
01100 For each non-null line: LineNo SHORTM Index of PUInS.PUI line
01200 0
01300 -10
01400
01500 PASS 2 reads the output file name and the intermediate page file names from
01600 PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
01700 each page from each page file, processes each line in each of
01800 its areas, and writes out a line printer image on the output file.
01900
02000 Each line is subject to three operations, in this order:
02100 (1) Substitute label values at each vertical tab.
02200 (2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
02300 (3) Generate underlining and super/sub-scripting as indicated by rubouts.
02400
02500 ;
02600
02700 DEFINE RKJ="COMMENT", LIBDEV="""DSK""", LIBPPN="""[A700PU00]""";
02800 DEFINE THRU = "STEP 1 UNTIL", DOWN = "STEP -1 UNTIL",
02900 ie = "COMMENT", AWHILE = "WHILE TRUE",
03000 INP(BRKTBL) = "INPUT(SCHAN, BRKTBL)", INNUM = "WORDIN(ICHAN)",
03100 SCN(BRKTBL)="(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))",
03200 SCNUM = "CVD(SCN(TO_ALTMODE_SKIP))",
03300 LPT = "1", TTY = "2", MIC = "3", XGP = "4",
03400 HORIZ="'40", VERTI="'41", CSIZE="'42", ULINE="'43", RSPCS="'44",
03500 LSPCS="'45", UDOTS="'46", RDOTS="'47", comment FR80 escape codes ;
03600 FULSTR(X) = "LENGTH(X)", NULSTR(X) = "(LENGTH(X)=0)",
03700 CR = "'15", LF = "'12", VT = "'13", FF = "'14", SP = "'40", BAR = "'30",
03800 RUBOUT = "'177", ALTMODE = "'176", COMMENT CMU: 176, NOT 175; TB = "'11",
03900 TO_ALTMODE_SKIP = "1", TO_LF_APPD = "2",
04000 ONE_CHAR = "3", BREAKER = "4", TO_RUB_ALT_SKIP = "5",
04100 FIML = "256",
04300 ANS(A) = "(S = ""A"" OR S = ""A"" + '40)";
04400 CMU CHANGE ALTMODE IS NOW '176 INSTEAD OF '175;
04500
04510 DEFINE COMMENT FOR XGP;
04520 USEA="('177&'14)", USEB="('177&'15)", VSB="('177&'20)",
04530 XTAB="('177&'30)",
04540 XGPNUM(N)="((N LSH -7) & N)";
04550
04600 INTEGER IML, IMC, comment, no. of lines and chars per page image ;
04700 DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
04800 LISTCHAN, comment output file ;
04900 PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
05000 I, J, K, L, M, N, DUMMY, comment general-purpose ;
05100 LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
05200 NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
05300 TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
05400 ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
05500 TOPLINE, NCOLS, NLINES, comment Area info ;
05600 COL, LEFTCH, comment Column info ;
05700 SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
05800 NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
05900 NEEDCR, comment, assures CR before every LF for Stanford LPT ;
06000 CHARW, LINENO, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
06100 TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;
06200
06300 EXTERNAL INTEGER RPGSW ;
00100 STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S,
00200 OWL, SS, T, ENDLINE, ENDPAGE, DELINT, CRLF ;
00300
00400
00500 REAL RATIO ;
00600
00700 INTEGER ARRAY CHARTBL[0:127], SLIDESG,RB,LBD[1:5] ;
00800
00900 STRING ARRAY LBF[1:5] ;
01000
01100 INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
01200 BEGIN
01300 INTEGER CH ;
01400 CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
01500 LOOKUP(CH, FILENAME, 0) ; RETURN(CH) ;
01600 END "READIN" ;
01700
01800 INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
01900 BEGIN
02000 INTEGER CH ;
02100 CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
02200 ENTER(CH, FILENAME, 0) ; RETURN(CH) ;
02300 END "WRITEON" ;
02400
02500 SIMPLE PROCEDURE WARN(STRING MESSG) ; OUTSTR(MESSG&CR&LF) ;
02600
02700 SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ; WARN("Impossible case index for "&HOW) ;
02800 STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
02900 RETURN('177 & OP & (IF OP≤'42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
03000 STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
03100 STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
03200 STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
03300 STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
03400 STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
03500 STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
03600 STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
03700 STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
03800
03900 RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
04000 IF N ≤ 0 THEN RETURN(NULL) ELSE
04100 IF N ≥ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
04200 RETURN(VSB&N);
04300
04400 PRELOAD_WITH "", " ", " ", " ", " ", " ", " ",
04500 " ", " ", " ", " " ;
04600 SAFE STRING ARRAY SPSARR[0:10] ;
04700
04800 INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ; IF N≤10 THEN RETURN(SPSARR[N MAX 0])
04900 ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
05000 ELSE BEGIN
05100 STRING S ; INTEGER I ;
05200 S ← SPSARR[10] ;
05300 FOR I ← 11 THRU N DO S ← S & SP ;
05400 RETURN(S) ;
05500 END ;
00100 COMMENT I N I T I A L I Z E ;
00200
00300 OUTSTR("P U B P A S S T W O - - -"&CR&LF) ;
00400 IML ← 55 ; IMC ← 69 ; PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
00500 SETBREAK(ONE_CHAR, NULL, NULL, "XA") ;
00600 SETBREAK(TO_ALTMODE_SKIP, ALTMODE, NULL, "IS") ;
00700 SETBREAK(TO_LF_APPD, LF, NULL, "IA") ;
00800 SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
00900 SETBREAK(TO_RUB_ALT_SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
01000 SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
01100 TMPFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01200 LISTFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01300 DEBUG ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
01400 DEVICE ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
01500 IF ¬RPGSW AND DEVICE ≠ XGP THEN COMMENT STARTED BY ".R PUB2" ;
01600 DO BEGIN
01700 OUTSTR("OUTPUT DEVICE (LPT or TTY) = ") ;
01800 S ← INCHWL ;
01900 DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE
02000 IF ANS(M) THEN MIC ELSE IF ANS(X) THEN XGP ELSE 0;
02100 END
02200 UNTIL DEVICE ;
02300 IF ¬RPGSW AND DEBUG THEN
02400 IF DEVICE = MIC THEN DEBUG ← 0
02500 ELSE DO BEGIN
02600 OUTSTR("DEBUG INFO IN RIGHT MARGIN? (Y or N) = ") ;
02700 S ← INCHWL ;
02800 DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
02900 END
03000 UNTIL DEBUG < 100 ;
03100 OUTSTR("WRITING PAGE ") ;
03200 DELINT ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
03300 ENDLINE ← LF ; ENDPAGE ← FF ;
03400 CASE DEVICE-1 OF
03500 BEGIN "DEV"
03600 comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
03700 comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
03800 comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
03900 IF DEBUG THEN BEGIN WARN("Won't put Debug info on Microfilm") ;
04000 DEBUG ← FALSE ; END END ;
04100 COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
04200 END "DEV" ;
04300 J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
04400 LABCHAN ← READIN("PULABL.PUI", FALSE, LABBRC, LABEOF) ;
04450 CHARW ← CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP));
04500 NL ← CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP)) ;
04600 LASL ← 1000 ; comment, last physical line occupied on the page ;
00100 BEGIN "INNER BLOCK"
00200
00300 STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
00400
00500 AWHILE DO
00600 BEGIN "LABEL"
00700 TABLE ← CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP)) ; IF LABEOF THEN DONE ;
00800 LABTAB[TABLE, CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP))] ←
00850 INPUT(LABCHAN, TO_ALTMODE_SKIP) &
00875 (IF DEVICE = XGP THEN
00887 (ALTMODE & INPUT(LABCHAN, TO_ALTMODE_SKIP))
00893 ELSE NULL);
00900 END "LABEL" ;
01000
01100
01200 COMMENT G O ! ;
01300 DO comment, This loop is re-entered only if page image grows ;
01400 BEGIN "SIZE"
01500 SAFE STRING ARRAY IMG[1:IML+IML], SEG[0:IMC+IMC], SRCREF[1:IML] ;
01600 SAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML] ;
01700 LABEL CONTINUE ;
01800
01900 INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
02000 BEGIN
02100 INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
02200 L ← LINE ; EXTRA ← LENGTH(S) ;
02300 WHILE CHAR < (HAD ← LASC[L]) DO L ← IF (F←LINK[L]) THEN F ELSE LINK[L]←AVAIL←AVAIL+1 ;
02400 T ← IMG[L] ; SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
02500 IF LENGTH(T) < HAD+SPACES+EXTRA THEN BEGIN comment no room -- must use concatenate ;
02600 SS ← SPS(SPACES) ; IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
02700 IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞] END
02800 ELSE BEGIN comment there's room in old string -- IDPB into it.;
02900 SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
03000 START_CODE "APPEND" LABEL LOOP1, LOOP2 ;
03100 MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
03200 MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
03300 LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
03400 END "APPEND" ;
03500 END ;
03600 RETURN(LASC[L] ← CHAR + EXTRA) ;
03700 END "APPD" ;
03800
03900 SIMPLE PROCEDURE CTRL(STRING S) ;
04000 BEGIN
04100 CHAR ← APPD(S) - LENGTH(S) ;
04200 LASC[L] ← CHAR ;
04300 FAKE[L] ← FAKE[L] + LENGTH(S) ;
04400 END "CTRL" ;
04500
04600 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
04700 BEGIN
04800 INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
04900 NUMCHARS ← RIGHTCHAR - UNDERLINE ;
05000 IF NUMCHARS > 0 THEN
05100 BEGIN
05200 SAVEHORIZ ← CHORIZ ;
05300 DESCEND ← CCSIZE DIV 4 ;
05400 CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
05500 SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
05600 DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
05700 UNDERLINE ← RIGHTCHAR ;
05800 END ;
05900 END "UNDERSCORE" ;
06000
06100 SIMPLE PROCEDURE CHANGESPACING ;
06200 IF (N←CHRS-CHAR-1)>0 ∧ (K←(J←N*CHORIZ+SHORTM)/N MIN 511)≠CHORIZ THEN
06300 BEGIN
06400 IF UNDERLINE≥0 THEN UNDERSCORE(CHAR) ;
06500 SHORTM ← J - K*N ;
06600 IF NOTFST ∧ (UNDERLINE<0 ∨ SHORTM<0) THEN
06700 BEGIN DORDOTS(SHORTM) ; SHORTM ← 0 END ;
06800 CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
06900 END "CHANGESPACING" ;
07000
07100 SIMPLE PROCEDURE RIGHTBOUND ;
07200 BEGIN COMMENT RIGHT BOUND OF ∞ ;
07300 INTEGER DEST, FILLIN ; STRING FILLER, OLBF ;
07350 INTEGER XFILL;
07400 IF SLIDETOP < 1 THEN BEGIN IMPOSSIBLE("SLIDETOP1") ; SLIDETOP ← 1 END ;
07500 FILLIN ← (IF LBD[SLIDETOP] < -900 THEN RB[SLIDETOP]-CHRS
07600 ELSE ((RB[SLIDETOP]-CHRS)-LBD[SLIDETOP]) DIV 2) MAX 0 ;
07700 DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
07800 IF FULSTR(OLBF) THEN
07900 BEGIN "NON-BLANKS"
08000 FILLER ← NULL ;
08100 WHILE CHRS < DEST DO
08200 BEGIN
08300 FILLER ← FILLER & OLBF ;
08400 CHRS ← CHRS + LENGTH(OLBF) ;
08500 END ;
08600 IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
08700 SEG[SLIDESG[SLIDETOP]] ← FILLER ;
08800 END "NON-BLANKS"
08900 ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT & "+" & CVS(IF DEVICE=XGP THEN LBD[SLIDETOP] ELSE FILLIN) ;
09000 CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
09100 BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
09200 END ;
00100 IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
00200 AWHILE DO
00300 BEGIN "FILE"
00400 PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ; IF SEQEOF THEN DONE ;
00500 IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
00600 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
00700 AWHILE DO
00800 BEGIN "PAGE"
00900 PAGEHIGH ← INNUM ; IF PAGEEOF ∨ PAGEHIGH≤0 THEN DONE ; PAGEWIDE ← INNUM ;
01000 IF PAGEHIGH > IML ∨ PAGEWIDE > IMC THEN
01100 BEGIN "EXPAND"
01200 IF DEVICE=MIC THEN
01300 BEGIN "FRAME SIZE"
01400 IF LASL ≠ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
01500 NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
01600 NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
01700 OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
01800 END "FRAME SIZE"
01900 ELSE IF DEVICE = LPT THEN
02000 BEGIN
02100 CMU: IF (LASL-1) MOD 66 + 1 ≤ 6 ∧ (PAGEHIGH-1) MOD 66 < 60 THEN ;
02200 OUT(LISTCHAN, ENDPAGE) ;
02300 ENDLINE ← CMU: IF PAGEHIGH≥54 THEN RUBOUT & '21 ELSE ; LF ;
02400 END ;
02500 IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
02600 DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
02700 END "EXPAND" ;
02800 CONTINUE: OUTSTR(CVS(PAGECT ← PAGECT + 1) & SP) ; AVAIL ← IML ;
02900 IF DEVICE = LPT THEN
03000 CMU:IF (IML-1) MOD 66 < 60 THEN; OUT(LISTCHAN, ENDPAGE)
03100 ;CMU: ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO OUT(LISTCHAN, ENDLINE) ;
03200 WHILE (TOPLINE ← INNUM) > -10 DO
03300 BEGIN "AREA"
03400 NCOLS ← INNUM ; NLINES ← INNUM ;
03500 FOR COL ← 1 THRU NCOLS DO
03600 BEGIN "COLUMN"
03700 LEFTCH ← INNUM ;
03800 WHILE (LINENO ← INNUM) DO
03900 BEGIN "LINE"
04000 SH ← SHORTM ← INNUM ; SG ← FSTBRK ← -1 ; BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
04100 LINE ← TOPLINE - 1 + LINENO ;
04200 IF LINE<1∨LINE>IML THEN BEGIN WARN("Area outside page"); LINE←LINE MAX 1 MIN IML END ;
04300 L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
04400 IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
04500 ELSE BEGIN FROMFILE ← TRUE ;
04600 WHILE L ≠ (M←CVD(INP(TO_ALTMODE_SKIP))) DO
04700 BEGIN S ← NULL ;
04800 DO S ← S & INP(TO_LF_APPD) UNTIL PAGEBRC = LF ;
04900 OWLS[M MOD FIML] ← S ;
05000 END ;
05100 END ;
05200 IF ¬DEBUG THEN S ← SCN(TO_ALTMODE_SKIP)
05300 ELSE BEGIN
05400 SRCREF[LINE] ← SRCREF[LINE] & " " & SCN(TO_RUB_ALT_SKIP) ;
05500 WHILE PAGEBRC ≠ ALTMODE DO
05600 BEGIN "ERROR MESSG"
05700 S ← SCN(TO_RUB_ALT_SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
05800 IF DEVICE=TTY ∨ (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SRCREF[L])+M ≤ 119 THEN
05900 SRCREF[L] ← SRCREF[L] & "..." & S ;
06000 END "ERROR MESSG" ;
06100 END ;
06200 DO BEGIN "PIECE"
06300 CHRS ← CHRS + LENGTH(SEG[SG ← SG + 1] ← SCN(BREAKER)) ;
06400 CASE CHARTBL[PAGEBRC] OF
06500 BEGIN comment by BRC ;
06600 ie 0 ... ; IMPOSSIBLE("BREAKER") ;
06700 ie 1 ... RUBOUT -- Font change ; BEGIN
06800 SEG[SG←SG+1] ← RUBOUT & (F←SCN(ONE_CHAR)) &
06900 (S ← IF F="-" ∨ F="+" ∨ F="=" THEN SCN(TO_ALTMODE_SKIP)
07000 ELSE IF F = "π" THEN SCN(ONE_CHAR) ELSE NULL) ;
07100 IF F = "π" THEN CHRS ← CHRS + 1
07200 ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
07300 ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
07400 ELSE IF F = "→" THEN
07500 BEGIN COMMENT ∞ ;
07600 IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN IMPOSSIBLE("SLIDETOP") ;
07700 SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
07800 LBD[SLIDETOP] ← SCNUM ; LBF[SLIDETOP] ← SCN(TO_ALTMODE_SKIP) ;
07900 END
08000 ELSE IF F = "←" THEN
08100 RIGHTBOUND
08200 ELSE IF F = "=" THEN BEGIN BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
08300 END ; COMMENT NOJUST LEFT OF TAB ;
08400 ie 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[SG←SG+1] ← ALTMODE END ;
08500 ie 3 ... VT -- label reference ;
08600 BEGIN "LABEL REF"
08650 STRING S;
08675 S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
08700 L ← LENGTH(SEG[SG←SG+1] ← SCAN(S, TO_ALTMODE_SKIP, DUMMY)) ;
08750 J ← CVD(S) ;
08800 SHORTM ← SHORTM - (IF DEVICE=XGP THEN J ELSE L) ; CHRS ← CHRS + L ;
08900 END "LABEL REF" ;
00100 ie 4 ... CR -- Justify it ;
00200 BEGIN "JUSTIFY"
00300 WHILE SLIDETOP DO BEGIN IMPOSSIBLE("SLIDE TOP") ; RIGHTBOUND END ;
00400 IF SHORTM < 0 THEN SHORTM ← 0 ;
00500 IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ
00600 ELSE BEGIN "DISTRIBUTE SPACES"
00700 COMMENT β(α,K) = [α(K+1)] - [αK],
00800 WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
00900 RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
01000 END "DISTRIBUTE SPACES" ;
01100 UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN IML ; CHAR←LEFTCH-1 MAX 0 ;
01200 NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
01300 IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
01400 FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
01500 BEGIN comment three cases ;
01600 ie 0 ... text ;
01700 BEGIN "TEXT SEG"
01800 IF UNDERLINE<0 THEN CHAR←APPD(S) ELSE
01900 IF DEVICE = MIC THEN
02000 BEGIN K ← LENGTH(S) ;
02100 CHAR ← APPD(S);
02200 WHILE K DO
02300 BEGIN COMMENT DON'T UNDERLINE BLANKS ;
02400 N ← LOP(S) ;
02500 IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
02600 K ← K - 1 ;
02700 END ;
02800 END
02900 ELSE IF DEVICE = XGP THEN
03000 BEGIN
03100 K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
03200 START!CODE "XGPUNDER"
03300 DEFINE LEN="2",SRC="3",DEST="4",RUB="5",ESC="6",R="7",CNT="'10",UBAR="'11";
03400 LABEL LOOP,ELOOP,SPACE,OUTT;
03500 SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVEI UBAR,BAR;
03600 LOOP: ILDB R,SRC;
03700 CAIN R,SP; JRST SPACE;
03800 IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
03900 ELOOP: SOJG LEN,LOOP;
04000 MOVEM CNT,N; JRST OUTT;
04100 SPACE: IDPB R,DEST;
04200 AOJA CNT,ELOOP;
04300 OUTT:
04400 END "XGPUNDER";
04500 CHAR←APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
04600 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
04700 END
04800 ELSE BEGIN CHAR ← APPD(S);
04900 K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR←CHAR-K ;
05000 START_CODE "UNDER" LABEL LOOP ;
05100 MOVE 2, K ; MOVE 3, SS ;
05200 LOOP: ILDB 4,3 ; CAIE 4,SP ; MOVEI 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
05300 END "UNDER" ; CHAR ← APPD(SS[1 TO LENGTH(S)]) ;
05400 END ;
05500 END "TEXT SEG" ;
00100 ie 1 ... RUBOUT -- Font Change ;
00200 IF (F←S[2 FOR 1])="↑" THEN
00300 IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE LINE←LINE-1 MAX 1
00400 ELSE IF F = "↓" THEN
00500 IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE LINE←LINE+1 MIN IML
00600 ELSE IF F = "_" THEN UNDERLINE ← CHAR
00700 ELSE IF F = "≡" THEN
00800 BEGIN "END UNDERLINED TEXT"
00900 IF DEVICE = MIC THEN UNDERSCORE(CHAR) ;
01000 UNDERLINE ← -1 ;
01100 END "END UNDERLINED TEXT"
01200 ELSE IF F="-" THEN
01300 IF DEVICE=MIC THEN CTRL(DOLSPCS(CVD(S[3 TO ∞])))
01400 ELSE CHAR←CHAR-CVD(S[3 TO ∞]) MAX 0
01500 ELSE IF F="*" THEN CHAR ← LASC[LINE] comment not always correct! ;
01600 ELSE IF F="+" THEN
01700 IF DEVICE=MIC THEN CTRL(DORSPCS(CVD(S[3 TO ∞])))
01750 ELSE IF DEVICE=XGP THEN CTRL(VARBLANK(CVD(S[3 TO INF])))
01800 ELSE CHAR←CHAR+CVD(S[3 TO ∞]) MIN IMC
01900 ELSE IF F="=" THEN
02000 BEGIN "TAB"
02100 F ← CVD(S[3 TO ∞]) ;
02125 IF DEVICE ≠ XGP THEN F ← F + LEFTCH - 1 MIN IMC MAX 1 ;
02150 IF DEVICE = XGP THEN CTRL(XTAB&XGPNUM(F))
02200 ELSE IF DEVICE ≠ MIC THEN CHAR ← F
02300 ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
02400 ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
02500 END "TAB"
02600 ELSE IF F = "π" THEN
02700 BEGIN F←S[∞ FOR 1] ;
02800 IF F = "_" THEN CHAR ← APPD(IF DEVICE≠MIC THEN "_" ELSE SP)
02900 ELSE IF DEVICE = TTY THEN CHAR ← APPD(F)
03000 ELSE BEGIN CHAR←APPD(RUBOUT&
03100 (IF DEVICE ≠ XGP THEN NULL ELSE '34)&
03200 (IF F="." THEN '0 ELSE IF F="G" THEN '11 ELSE IF F="∂" THEN '12 ELSE IF F
03300 ="~" THEN '13 ELSE IF F="-" THEN '14 ELSE IF F="+" THEN '15 ELSE 0))-(IF DEVICE = XGP THEN 2 ELSE 1) ;
03400 LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + (IF DEVICE = XGP THEN 2 ELSE 1) ; END ;
03500 IF UNDERLINE≥0 ∧ DEVICE≠MIC THEN BEGIN CHAR←CHAR-1; CHAR←APPD(BAR) END ;
03600 END
03700 ELSE IF F = "←" THEN BEGIN END
03800 ELSE IF F="A" THEN CTRL(USEA)
03900 ELSE IF F="B" THEN CTRL(USEB)
04000 ELSE IF F=RUBOUT THEN IF DEVICE≠XGP THEN CHAR←APPD(SP) ELSE
04100 BEGIN
04200 CHAR←APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
04300 END
04400 ELSE IMPOSSIBLE("FONT `"&F&"'") ;
00100 ie 2 ... ALTMODE -- word break ;
00200 IF SHORTM ∧ G > FSTBRK THEN
00300 IF DEVICE ≠ MIC THEN
00400 BEGIN "SPREAD"
00500 TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
00600 IF DEVICE = XGP THEN
00700 BEGIN "DOVSB"
00800 CTRL(VARBLANK((TERMX-TERM) MIN SHORTM));
00900 SHORTM←(SHORTM-TERMX+TERM) MAX 0;
01000 END "DOVSB"
01100 ELSE CHAR ← CHAR + TERMX - TERM MIN IMC ;
01200 TERM ← TERMX ;
01300 END "SPREAD"
01400 ELSE CHANGESPACING
01450 ELSE IF SHORTM AND DEVICE=XGP THEN
01460 BEGIN
01470 CHAR←APPD(SP);
01480 SHORTM←(SHORTM-CHARW) MAX 0;
01490 END;
01500 ie 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
01600 END ; COMMENT three cases ;
01700 IF CHORIZ ≠ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ;
01800 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
01900 END "JUSTIFY" ;
00100 ie 5 ... LF ; BEGIN END ;
00200 END ; comment, by BRC ;
00300 END "PIECE"
00400 UNTIL PAGEBRC = LF ;
00500 END "LINE" ;
00600 END "COLUMN" ;
00700 END "AREA" ;
00800
00900 FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
01000
01100 F ← 120 - (IMC MAX 78) ;
01200 FOR N ← 1 THRU LASL DO
01300 BEGIN "LIST LINE"
01400 L ← N ; IF DEBUG ∧ LENGTH(S←SRCREF[L])>F ∧ DEVICE=LPT THEN S←S[1 TO F] ;
01500 NEEDCR ← TRUE ;
01600 DO BEGIN "PART LINE"
01700 IF M ← LASC[L] THEN
01800 BEGIN "NONBLANK"
01900 OUT(LISTCHAN, IMG[L][1 TO M+FAKE[L]]) ;
02000 IF DEBUG ∧ L=N THEN OUT(LISTCHAN, SPS((IMC MAX 80)-M) & S);
02100 OUT(LISTCHAN, CR) ; NEEDCR ← FALSE ;
02200 END "NONBLANK" ;
02300 M ← L ; L ← LINK[M] ; LINK[M] ← LASC[M] ← FAKE[M] ← 0 ;
02400 END "PART LINE" UNTIL L=0 ;
02500 IF NEEDCR THEN OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
02600 OUT(LISTCHAN, ENDLINE) ;
02700 IF DEBUG THEN SRCREF[N] ← NULL ;
02800 END "LIST LINE" ;
02900
03000 IF DEVICE ≠ LPT THEN OUT(LISTCHAN, ENDPAGE) ;
03100
03200 END "PAGE" ;
03300
03400 IF ¬(PAGEEOF ∨ PAGEHIGH≤0) THEN DONE ; comment expand IMG ;
03500 RELEASE(ICHAN) ; RELEASE(SCHAN) ;
03600 END "FILE" ;
03700
03800 END "SIZE" UNTIL SEQEOF ;
03900
04000 OUT(LISTCHAN, ENDPAGE) ;
04100
04200 RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
04300 END "INNER BLOCK" ;
04400
04500 CMU:BEGIN EXTERNAL PROCEDURE K_OUT ;CMU: K_OUT END ; COMMENT ** ** ** ** ** ;
04600
04700 OUTSTR("PASS TWO DONE" & CRLF) ;
04800 IF DELINT="A" ∨ DELINT="a" THEN
04900 BEGIN
05000 OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
05100 DELINT ← INCHWL ;
05200 END ;
05300 IF DELINT="Y" ∨ DELINT="y" THEN
05400 BEGIN "DELETE INTERMEDIATE FILES"
05500 SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
05600 FOR I ← LISTFILE, DEBUG, DEVICE, DELINT DO INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
05700 LABCHAN ← READIN("PULABL.PUI", FALSE, LABBRC, LABEOF) ;
05800 RENAME(LABCHAN, NULL, 0, I) ; COMMENT DELETE ;
05900 AWHILE DO
06000 BEGIN
06100 PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
06200 IF SEQEOF THEN DONE ;
06300 IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
06400 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
06500 SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
06600 RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
06700 END ;
06800 RENAME(SEQCHAN, NULL, 0, I) ;
06900 END "DELETE INTERMEDIATE FILES"
07000 ELSE IF DELINT≠"N" ∧ DELINT≠"n" THEN WARN(DELINT&"? -- .PUI FILES WERE NOT DELETED") ;
07100
00100 IF DEVICE = MIC THEN
00200 BEGIN "PASS 3"
00300 INTEGER FCHAN ;
00400 INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START_CODE MOVE 1, A ; END ;
00500 INTEGER ARRAY PASSTHREE[0:4] ;
00600 FCHAN ← WRITEON("$PUB$.RPG") ;
00700 OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
00800 RELEASE(FCHAN) ;
00900 PASSTHREE[0] ← CVSIX("DSK") ;
01000 PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
01100 PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
01200 OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
01300 CALL(CORELOC(PASSTHREE), "SWAP") ;
01400 END "PASS 3" ;
01500
01600 IF DEVICE = XGP THEN
01700 BEGIN "RUN DOXAP"
01800 INTEGER ARRAY RUNBLK[0:5];
01900 INTEGER C,D;
02000 DEFINE CALLI = "'47000000000";
02100 INTEGER PROCEDURE PJOB;
02200 START!CODE CALLI 1, '30; END;
02300
02400 SETFORMAT(-3,0);
02500 C←WRITEON(CVS(PJOB)&"PB3.TMP");
02600 OUT(C,LISTFILE&CR&LF);
02700 RELEASE(C);
02800
02900 RUNBLK[0]←CVSIX(LIBDEV);
03000 RUNBLK[1]←CVFIL("PUB3"&LIBPPN,RUNBLK[2],RUNBLK[4]);
03100 RUNBLK[3]←RUNBLK[5]←0;
03200 START!CODE
03300 MOVE 1, RUNBLK;
03400 HRLI 1, 1;
03500 CALLI 1, '35;
03600 JRST 4, ;
03700 END;
03800 END "RUN DOXAP";
03900 START!CODE
04000 DEFINE EXIT="'047000000012";
04100 EXIT 1,;
04200 EXIT ;
04300 END;
04400 END "PUB2" ;